(module fmap mzscheme
  (provide 
   make-fmap
   make-fmap/fn
   fmap-insert
   fmap-insert-all
   fmap->assoc
   fmap-get
   fmap-pairs
   fmap-remove
   fmap-remove-all
   fmap-member?
   fmap-map
   fmap-map-pairs
   fmap-map-keys
   fmap-map-values
   fmap-fold
   fmap-keys
   fmap-vals
   fmap-size
   fmap?)

  
  (require (lib "etc.ss")
           (lib "list.ss")
           (lib "unitsig.ss")
           (lib "list.ss")
           "set.ss"
           "units/ordered.ss"
           "units/fmap.ss")

  (define-struct fns (insert insert-all ->assoc
                             get pairs remove remove-all member?
                             map map-pairs map-keys map-values
                             fold keys vals size))
  
  
  (define-struct tt (fns data))

  (define fmap? tt?)

  (define make-fmap
    (opt-lambda ([set@ unbalanced-search-tree-set@]
                 [order@ eq-hash-order@])
      (use-fmap (instantiate-fmap set@ order@))
      (make-tt (make-fns insert insert-all ->assoc
                         get pairs remove remove-all member?
                         map map-pairs map-keys map-values
                         fold keys vals size)
               empty)))
  
  (define make-fmap/fn
    (opt-lambda (elm<
                 [set@ unbalanced-search-tree-set@]
                 [elm= (lambda (a b) (and (not (elm< a b)) (not (elm< b a))))])
      (let ([_elm< elm<]
            [_elm= elm=]
            [_elm<= (lambda (a b) (or (elm< a b) (elm= a b)))])
      (make-fmap
       set@ 
       (unit/sig ordered^
         (import)
         (define elm< _elm<)
         (define elm= _elm=)
         (define elm<= _elm<=))))))
  
  (define (invoke t field-fn . args)
    (make-tt (tt-fns t)
             (apply (field-fn (tt-fns t)) args)))

  (define (fmap-insert t k v) (invoke t fns-insert (tt-data t) k v))
  (define (fmap-insert-all t lst) (invoke t fns-insert-all (tt-data t) lst))
  (define (fmap-remove t k) (invoke t fns-remove (tt-data t) k))
  (define (fmap-remove-all t lst) (invoke t fns-remove-all (tt-data t) lst))
  (define (fmap-map-pairs t) (invoke t fns-map-pairs (tt-data t)))
  (define (fmap-map-keys t) (invoke t fns-map-keys (tt-data t)))
  (define (fmap-map-values t) (invoke t fns-map-values (tt-data t)))

  (define (fmap->assoc t) ((fns-->assoc (tt-fns t)) (tt-data t)))
  (define (fmap-get t k) ((fns-get (tt-fns t)) (tt-data t) k))
  (define (fmap-pairs t) ((fns-pairs (tt-fns t)) (tt-data t)))
  (define (fmap-member? t k) ((fns-member? (tt-fns t)) (tt-data t) k))
  (define (fmap-map fn t) ((fns-map (tt-fns t)) fn (tt-data t)))
  (define (fmap-fold fn init t) ((fns-fold (tt-fns t)) fn init (tt-data t)))
  (define (fmap-keys t) ((fns-keys (tt-fns t)) (tt-data t)))
  (define (fmap-vals t) ((fns-vals (tt-fns t)) (tt-data t)))
  (define (fmap-size t) ((fns-size (tt-fns t)) (tt-data t)))

  (define (test)
    (printf "~a~n"
            (fmap-pairs (fmap-remove (fmap-insert-all (make-fmap) '((1 10) (2 20) (3 30) (0 0) (17 170))) 3))))

  (test)
)
